00010	C***** BEAMS,  MARKS,  XNOTE, BAUTO *******
00100		SUBROUTINE BEAMS
00200		COMMON/ALF/INP(72),ML/FRMT/F78F(1),FA1(1),FA5(1),IREAD
00400		COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
00500		COMMON/SCX/RHY(4),JALPHA(19),JX,U,JZ,IRHY,JD,KA,KB,IZ
00510		1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
00650		1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
00750		1 /STF/RSTFAC(8),RSTJC
00760		DIMENSION R(8,100)
00765		COMMON /XRN/RN(4000)
00770		EQUIVALENCE (R,RN(3001))
00800		DATA BX/25./,BY/.5/
00900	
01000		JAUTO=-1
01100	2500	DO 1500 K=1,72
01110		IF(INP(K).EQ.'B')GO TO 22
01120	C  B=AUTOMATIC BEAMS.
01200		IF(INP(K).NE.'*')GO TO 1500
01300		INP(72)='*'
01400		GO TO 500
01500	1500	CONTINUE
01600	C ABOVE FOR 2ND LINE OF INPUT.
01620	22	REREAD F78F,A,B
01640	C  TYPE '2B' OR '3B' FOR AUTOMATIC BEAMS. (2=DUPLE  3=TRIPLE)
01660		IF(IREAD.NE.0)A=B
01680		A=A/2.
01700	C  '2'=1  '3'=1.5
01710		JAUTO=0
01720		K=0
01740		N=0
01760		J=0
01780		INP(72)='*'
01800	122	K=K+1
01820		L=K
01840	222	C=ABS(V(K))
01860		IF(V(K).GT.0)GO TO 922
01880	1022	N=N+1
01900	C  SUBTRACTS NUMB. FOR REST.
01920		IF(C.GE.A)GO TO 1222
01940	1322	L=L+1
01960		GO TO 422
01980	1222	IF(AMOD(C,A).NE.0)GO TO 622
02000		IF(K-L.LE.1)GO TO 522
02020		L=L+1
02040		GO TO 722
02060	922	IF(C.EQ.A)GO TO 522
02080	422	IF(K.EQ.IRHY)GO TO 322
02100		K=K+1
02120		C=C+ABS(V(K))
02140		IF(V(K))GO TO 1022
02160		IF(C.EQ.A)GO TO 722
02180		IF(C.LT.A)GO TO 422
02200		C=AMOD(C,A)
02240		IF(K-L.LE.1)GO TO 622
02260		CALL BAUTO(J,L,K-1,N)
02320	622	L=K
02330		IF(ABS(V(K)).GE.A.OR.C.EQ.0)L=L+1
02340		GO TO 422
02380	722	IF(K.EQ.L)GO TO 522
02382	1722	DO 1422 IS=L,K
02385	1422	IF(V(IS).GE.1)GO TO 1522
02390	C WON'T PUT BEAMS WHERE NOT LOGICAL.
02395		CALL BAUTO(J,L,K,N)
02460	522	IF(K.LT.IRHY)GO TO 122
02480	
02490	322	IF(J.EQ.0)RETURN
02495	C  NO BEAMS - SO GO BACK.
02500		DO 822 K=J+1,IRHY+2
02520	822	V(K)=0
02540		J=0
02560		GO TO 511
02580	1522	IF(IS-1.GT.L)GO TO 1622
02600	1822	L=IS+1
02620		IF(L.LT.K)GO TO 1722
02640		GO TO 522
02660	1622	CALL BAUTO(J,L,IS-1,N)
02680		GO TO 1822
02690	C  ALL THIS ↑↑ FOR QUARTERS IN TRIPLE TIME UNITS!
02700	
02713	500	REREAD F78F,V
02739		J=0
02752		IF(IREAD.NE.0)J=1
02765	511	J=J+1
02778		N=V(J)
02830	C  SKIPS LINE #S.
02843	1511	JMP=1
02856	505	L=0
02869		K=0
02882		POS=-10.
02900		IF(MODE.EQ.4)GO TO 5030
03000	C  MODE 4 IS FOR ACCENTS ETC.
03050		IF(N.GT.100)GO TO 161
03060	C  IZ=TOTAL # OF NOTES
03100		IZ=IZ+1
03110		R(8,IZ)=0
03200		IS=0
03300	503	IF(N.GT.0)GO TO 5031
03400		IS=-1
03410		POS=-1.3
03500	C  -1= SLUR INTO 1ST NOTE.
03600	C	RA=10
03700	C  SETS POS OF LFT SIDE (-10+9, THEN +2)
03800		GO TO 5060
03900	5031	IF(N.LE.80)GO TO 5030
04200	C  203 WILL BECOME 201 AT 61
04310		POS=202
04400		GO TO 550
04500	C  -1=1ST SLUR FROM NO NOTE; 99= LAST, TO NO NOTE
04600	5030	L=L+1
04700	502	K=K+1
04800		IF(R(1,K).NE.1.)GO TO 502
04900	C  IS IT A NOTE?
05000		P=R(2,K)
05100		IF(P.EQ.POS)GO TO 502
05200	C  SKIPS DBLSTPS
05300		POS=P
05400	506	IF(L.NE.N)GO TO 5030
05600	5060	IF(MODE.EQ.4)GO TO 30
05700	C  NOW SLUR STARTS
05800		IF(JMP)GO TO 504
05900	C  JMP=-1 MEANS END NOTE OF GROUP
05910		J=J+1
06000		NN=V(J)
06100		MK=N
06110		N=NN
06155		IF(N)N=-N
06200		M=K
06300		JA=2
06400		JB=4
06500		KN=K
06600		IF(IS)GO TO 550
06800		RB=0
06900		IF(MODE.EQ.3)GO TO 550
07000		A=XNOTE(K)
07050	C XNOTE IS AMOD(R(4,K),100.)
07100	C  SAVES LEVEL OF 1ST NOTE.
07200	504	RB=2
07300		B=AMOD(R(6,K),1.0)
07400		IF(B.GE.0.5)RB=4.
07500		IF(B.EQ.0.4)RB=6.
07600	C   THESE ARE FOR >(.5) AND ∧(.4) ACCENTS
07700		IF(NN)RB=-RB
07800	C  DIP IS SET BY PARAM 7. (STEM DIR. IS AUTOMATIC)
08010	550	R(JA,IZ)=POS
08100		R(JB,IZ)=XNOTE(K)+RB
08200		JA=6
08300		JB=5
08500	C  MK=# OF 1ST NOTE, N=END NOTE NOW
08900		JMP=-JMP
09000		IF(JMP.GT.0)GO TO 1503
09100	C  GO FIND RT. SIDE OF SLUR
09200		IF(N.LE.MK)N=MK+1
09300	C  PICKS UP TYPO ERRORS
09400		JK=0
09500		IF(R(7,K).GE.10)JK=-1
09600	C  CHECKS FOR DOT AFTER 1ST NOTE -- FOR TIES.
09700		GO TO 503
09900	
10000	1503	R(3,IZ)=STAFF
10100		IF(MODE.EQ.3)GO TO 35
10150		R(8,IZ)=-1
10200		R(1,IZ)=8
10210		IF(IS)R(4,IZ)=R(5,IZ)
10300		NN=-NN
10400	C  IF NN IS NEG. NOW IT MEANS STEM DOWN.(DIP IS UP!)
10550		IF(MK.EQ.IRHY.OR.N.EQ.1)GO TO 61
10600		IF(((XNOTE(K).NE.A.OR.N-MK.GT.1).AND.IS.GE.0.
10626		1 ).OR.IS)GO TO 60
10652	C  .N. WAS .KQ. 12/73
10800	C  JUMP IF NOT ADJACENT NOTE AT SAME PITCH AND NOT 1ST OR LAST.
10810	61	C=9
10820		IF(JK)C=12
10830		IF(R(6,IZ)-R(2,IZ)-C*RSTJC)GO TO 65
10900		IF(IS)A=XNOTE(K)
11000		A=A+.7
11100		IF(NN.GT.0)A=A-1.4
11200	C  TO RAISE OR LOWER IT .5
11300		R(4,IZ)=A
11400		R(5,IZ)=A
11650		B=-2
11750		IF(JK)B=-3
11800	C  JK=-1 WHEN NOTE IS DOTTED.
12600	C THIS PUTS TIE BETWEEN (NOT ABOVE OR BELOW) NTS. NO STEM CHNG.
12750		R(8,IZ)=B
12800		GO TO 65
13110	161	J=J+1
13120		K=V(J)
13130		M=N-100
13140	C  THIS WILL DIRECT STEMS ON NOTES M THROUGH K. IF -K,STEMS DN.
13150		NN=K
13160		IF(K)K=-K
13200	
13300	C  NEXT IS STEM INVERTER
13500	60	JB=1
13600		RB=10.
13800		IF(NN)GO TO 509
13900	C  IF NN IS NEG. NOW IT MEANS STEM DOWN.(DIP IS UP!)
14100		RB=-RB
14200		JB=2
14300	509	DO 507 L=M,K
14400		IF(R(1,L).NE.1.)GO TO 507
14500		JA=R(5,L)/10.
14600		IF(JA.EQ.0)GO TO 507
14700		IF(JA.EQ.JB)R(5,L)=R(5,L)+RB
14800	507	CONTINUE
14810		IF(N.GT.100)GO TO 514
14820	C  JUMP IF ONLY REVERSING STEMS.
14900		GO TO 200
15000	62	IF(NN)GO TO 64
15100		IF(A.EQ.DMAX)GO TO 65
15200		AA=B-DMAX
15300		GO TO 63
15400	65	AA=0
15500		GO TO 63
15600	64	IF(A.EQ.UMAX)GO TO 65
15700		AA=UMAX-B
16010	63	RA=R(6,IZ)
16100		RB=R(2,IZ)
16200		X=1.5+(RA-RB)/BX
16300		IF(AA.GT.0)X=X+AA*BY
16400		IF(NN.GT.0)X=-X
16500	510	R(7,IZ)=X
16600		IF(JB)CALL BMX(RA)
16700	514	J=J+1
16800	1514	N=V(J)
16900		IF(N.NE.0)GO TO 505
17000		IF(J.LT.68)GO TO 514
17100	C  SOMETIMES A SLASH IS SEEN AS A 0 (WHEN PRECEDED BY SPACE).
17200		IF(INP(72).EQ.'*')RETURN
17300		IF(IREAD.NE.0)GO TO 3501
17400		CALL TYPE
17500		GO TO 2500
17600	3501	READ(22,2501)J,INP
17700		GO TO 2500
17800	C  FOR 2ND LINE.
17900	2501	FORMAT(I,72A1)
18000	
18100	
18200	35	RA=AMOD(R(7,KN),10.0)
18300	C  RA=# OF TAILS,  KN=1ST NOTE, K=LAST  ('MOD' FOR DOTTED NOTES.)
18400		R(1,IZ)=9
18500		JMAX=0
18600		IF(N-MK.EQ.1)JMAX=-1
18800		X=10
18900		IF(NN)X=20
19000		JB=0
19100		DO 2 L=KN+1,K
19150		IF(R(1,L).NE.2)GO TO 12
19160		RB=R(5,L)
19170		GO TO 112
19200	12	IF(R(1,L).NE.1.OR.R(5,L).LT.10.)GO TO 2
19300	C  SKIPS NON-NOTES AND DBLSTPS
19350		IF(ABS(R(4,L)).GE.100)GO TO 2
19375	C  SKIPS GRACE NOTES
19400		RB=AMOD(R(7,L),10.0)
19500	112	IF(RA.EQ.RB)GO TO 2
19600		JB=-1
19700	C   FLAG FOR MIXED NUM. OF BEAMS
19800		IF(RB.LT.RA.AND.RB.NE.0)RA=RB
19900	2	CONTINUE
20000	C  ABOVE FINDS SMALLEST # OF TAILS.  NEXT FOR HGTS.
20100		X=X+RA
20200	C  # OF BEAMS.  IT'S PUT IN  DOWN BELOW 550.
20300	200	A=XNOTE(KN)
20500	C   A=NOTE 1.
20600		UMAX=A
20700		DMAX=A
20800	C  UP MAX. NOTE #, DOWN MAX. NOTE #.
20900	103	DO 3 M=KN,K
21000		IF(R(1,M).NE.1.OR.ABS(R(4,M)).GE.100)GO TO 3
21100	C  SKIPS NON-NOTES
21200	7	Y=R(5,M)
21300		B=XNOTE(M)
21400	33	IF(NN.GT.0.)GO TO 5
21600	C  JUMP IF STEM UP
21700		IF(Y.LT.20..AND.Y.GE.10.)R(5,M)=Y+10.
21800		GO TO 55
21900	5	IF(Y.GE.20.)R(5,M)=Y-10.
22000	C    STEM UP
22100	55	IF(B.LT.UMAX)GO TO 13
22200		UMAX=B
22300		IF(JMAX.OR.M.EQ.KN.OR.M.EQ.K)GO TO 3
22400		UMAX=UMAX+1
22500		GO TO 3
22600	13	IF(B.GT.DMAX)GO TO 3
22700		DMAX=B
22800		IF(JMAX.OR.M.EQ.KN.OR.M.EQ.K)GO TO 3
22900		DMAX=DMAX-1
23000	3	CONTINUE
23100	C  LOOKS FOR LOWER AND HIGHER NOTES THAN NOTE 1.
23200	4	IF(MODE.EQ.5)GO TO 62
23300		AA=A
23400		BB=B
23500		C=1
23600		IF(X.LT.20.)GO TO 48
23700	C  JUMP IF STEM IS UP
23800		CALL EXCH(AA,BB)
23900		C=-C
24000		CALL EXCH(UMAX,DMAX)
24100	48	IF(AA.LT.BB)GO TO 45
24200		IF(UMAX.EQ.A)GO TO 46
24300	47	A=UMAX-C
24400		B=A
24500		GO TO 444
24600	46	IF(UMAX.GT.AA)GO TO 47
24800		GO TO 49
24900	45	IF(UMAX.NE.B)GO TO 47
25100	49	A=AA
25200		B=BB
25300		IF(X.GE.20)CALL EXCH(A,B)
25400	
25410	444	R(3,IZ)=STAFF 
25510	446	IF(ABS(A-B).LE.6)GO TO 14
25512	C  LIMITS SLOPE OF BEAM
25515		IF(X.GE.20)GO TO 141
25520		IF(B.GT.A)GO TO 140
25530	142	B=A-6*C
25540		GO TO 14
25542	141	IF(B.GT.A)GO TO 142
25550	140	A=B-6*C
25600	14	R(4,IZ)=A
25700	445	R(5,IZ)=B
25800	C   MAKES HORIZONTAL BEAMS IF PATTERN IS UP-DOWN.
25900		R(6,IZ)=R(2,K)
26000	C  ABOVE IS POS.2
26010		IF(JAUTO.OR.UMAX+DMAX.LT.14)GO TO 510
26028		X=X+10
26046	C  SETS AUTO. BEAMS' STEM DIRECTION.
26064		DO 1446 L=KN,K
26082	1446	IF(R(5,L).GE.10)R(5,L)=AMOD(R(5,L),10.)+20.
26100		GO TO 510
26200	
26300	C   NEXT IS FOR ACCENTS AND OTHER MARKS
26400	
26500	30	CALL MARKS(RA)
26510		J=J+1
26600		IF(RA.EQ.99)RA=V(J)
26800	C  IF STEM IS DOWN OR THERE ARE NOTES BELOW(DBL STP), POSITION
26900	C    OF ACCENT WILL BE INVERTED.
27000		RB=R(6,K)
27010		B=10.
27055		IF(RA.EQ.6)RA=26.
27077	C TEMPORARY CHANGE FOR FERMATA*******
27100		IF(RA.GT.10.)RA=RA/10.
27105		A=ABS(AMOD(RB,1.))
27110		IF(A.EQ.0)GO TO 301
27115		IF(RA.GT.3)GO TO 303
27120		RB=FLOAT(IFIX(RB))
27125		RA=RA+A/10.
27127	C  THIS PUTS 2-DIGIT CODE BEFORE 1-DIGIT CODE.
27130		GO TO 301
27135	303	IF(A.LT..3)GO TO 302
27140		B=100.
27145		GO TO 301
27150	302	B=1000.
27200	301	IF(RB.LT.0)RA=-RA
27300		R(6,K)=RB+RA/B
27400		GO TO 514
27500	C   USES 4-7,9,11-13 FOR ACC. > FERM. DOT - DNBOW UPBOW HARM.
27600	C  NOTE#,ACCENT#/N,A/N,A*
27700		END
27800	
27900		FUNCTION XNOTE(J)
28010		COMMON/XRN/RN(4000)
28020		DIMENSION R(8,100)
28030		EQUIVALENCE (R,RN(3001))
28100		XNOTE=AMOD(R(4,J),100.)
28200		END
28300	
28320		SUBROUTINE BAUTO(J,L,K,N)
28900	C  FOR AUTOMATIC BEAMS.
29000		COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
29100		J=J+2
29120		V(J-1)=L-N
29140		V(J)=K-N
29160		END